home *** CD-ROM | disk | FTP | other *** search
- .title k11atr process attribute packets
- .ident /1.0.02/
- .enabl gbl
-
- ; 18-Apr-84 11:20:59 Brian Nelson
- ;
- ; 24-Mar-86 12:00:56 BDN Major revision which has some rather
- ; unpleasant compatibility problems with
- ; older Kermit-11's.
- ;
- ; 12-Sep-86 10:37:04 BDN Convert for I/D space running
- ;
- ; Copyright (C) 1984 Change Software, Inc.
- ;
- ;
- ; Process attribute packets for RSTS/E and RSX11M/M+
- ;
- ; This module is intended to be placed into an overlay
- ; which MUST be the 'ERROR' cotree as the server, which
- ; is overlayed in the 'UTILTY' cotree can indirectly
- ; call the module through the packet control routines.
- ; This module will also be rather RMS11 dependent.
- ;
- ;
- ; Get the Kermi-11 common macro definition INCLUDE file
-
-
-
- .if ndf, K11INC
- .ift
- .include /IN:K11MAC.MAC/
- .endc
-
-
- .psect $pdata
-
- watt: .word sn.sys ,sn.typ ,sn.fab ,sn.pr0 ,sn.pr1 ,sn.len ,sn.fty
- ;- .word sn.cdt
- .word 0
- attrty: .byte 41 ,42 ,43 ,44 ,45 ,46 ,47
- .byte 50 ,51 ,52 ,53 ,54 ,55 ,56
- .byte 57 ,60 ,61
- .byte 0
- .even
-
- attrds: .word at.$$
- .word at.len ,at.typ ,at.cre ,at.id ,at.bil ,at.area,at.pas
- .word at.bsiz ,at.acc ,at.enc ,at.dis ,at.pr0 ,at.pr1 ,at.sys
- .word at.for ,at.fab ,at.xle
-
- badpak: .asciz /Unknown attribute packet type /
- incomp: .ascii /?K11-ATR Protocol bugfix detected. Use/<CR><LF>
- .asciz /SET NOATT and see K11.BWR, K11INS.DOC./<CR><LF>
- .even
-
- .psect tempda ,rw,d,lcl,rel,con
- curatr: .blkb 200
-
- .psect $code
-
-
- .sbttl return the next attribute packet to send
-
- ; W $ A T T R
- ;
- ; input: @r5 filename address
- ; 2(r5) lun it's using
- ; 4(r5) output packet address
- ;
- ; output: r0 rms error code, else zero
- ; r1 > 0 the packet length, also come back for more later
- ; r1 = 0 no more packets or else receiver can't handle them
-
-
- w$attr::save <r2,r3,r4> ; save registers that we may use here
- bitb #capa.a ,conpar+p.capas ; the other system handle 'A' packets?
- beq 90$ ; no, exit with 'eof'
- 10$: mov 4(r5) ,r4 ; point to the packet
- mov atrctx ,r0 ; now dispatch on what to send next
- asl r0 ; simple to do
- tst watt(r0) ; all done ?
- beq 90$ ; yes, just exit then
- jsr pc ,@watt(r0) ; and do it
- inc atrctx ; next time, do the next one in the list
- tst r0 ; was it possible to do this attr?
- bne 10$ ; no, try the next one then
- strlen 4(r5) ; get the length and return it
- mov r0 ,r1 ; and say that this packet is for real
- clr r0 ; exit without error
- br 100$ ; bye
-
- 90$: clr r0 ; all done, no more attributes to
- clr r1 ; send over
- clr atrctx ; init for the next file we send
-
- 100$: unsave <r4,r3,r2> ; pop these and exit
- return ; bye
-
-
-
-
-
- .sbttl dispatch routines for sending 'a' packets
- .enabl lsb
-
- sn.sys: call getsys ; get the system type first
- scan r0 ,#200$ ; find out what we are
- tst r0 ; did it work ?
- beq 110$ ; no
- movb #'. ,(r4)+ ; sys id attr packet
- movb #42 ,(r4)+ ; /49/ Length of whats to follow
- movb #'D&137 ,(r4)+ ; return the vendor code (DEC)
- movb 210$(r0),(r4)+ ; and the system type
- clrb @r4 ; .asciz
- clr r0 ; say it worked
- return ; bye
-
- 110$: mov sp ,r0 ; it failed
- return
-
-
- .save
- .psect $PDATA ,D
- 200$: .byte sy$11m ,sy$ias ,sy$rsts,sy$mpl ,sy$rt ,sy$pos ,0
- 210$: .byte 0
- .byte '8 ,'9 ,'A&137 ,'8 ,'B&137 ,'C&137 ,0
- .even
- .restore
- .dsabl lsb
-
-
-
- .sbttl send a copy of the ifab over
-
-
- ; The routine 'GETATR' takes the directory (or file header) information
- ; regarding the file format from the IFAB allocated to the FAB for the
- ; file currently being sent. This data is converted to octal strings and
- ; then sent over as an ATTRIBUTE packet with a type of '0', which is the
- ; type reserved for system specific data.
- ; The receiver KERMIT should ALWAYS get the SYSTEM and EXECUTIVE type
- ; attribute packet first so it can decide whether or not it wants to use
- ; the data being sent.
- ;
- ; For instance, the file A.A would have a packet sent over as in below
- ;
- ; Name .Typ Size Prot Access Date Time Clu RTS Pos
- ;A .A 1 < 60> 01-May-84 01-May-84 10:17 AM 4 ...RSX 3493
- ; RF:VAR=132 FO:SEQ USED:1:98 RECSI:46 CC:IMP
- ;
- ;
- ;
- ;SPACK - Length 78 Type A Paknum 3
- ;0001002 000056 000000 000001 000000 000001 000142 000000 000204 000000 000000
-
-
-
-
- sn.fab: calls getatr ,<2(r5),#at$fab>; get the ifab stuff now
- tst r0 ; but did it work?
- bmi 100$ ; no, it crapped out
- movb #'0 ,(r4)+ ; return sys type attr code
- movb #<13*7>+40,(r4)+ ; Length of data to follow.
- mov r4 ,r0 ; fill it with spaces first
- mov #13*7 ,r1 ; simple
- 5$: movb #40 ,(r0)+ ;
- sob r1 ,5$ ; next
- mov #at$fab ,r2 ; where we store such things
- mov #13 ,r0 ; number of words to send
- 10$: calls l$otoa ,<r4,(r2)+> ; do it
- add #7 ,r4 ; skip over it
- sob r0 ,10$ ; next
- clr r0 ; say that it worked
- clrb @r4 ; .asciz
- 100$: return
-
-
- .sbttl send file type (ascii,binary), protection and size
-
- ; SN.FTY added /52/
-
- .enabl lsb
-
- sn.fty: movb #'0 ,(r4)+ ; Attribute type (SYS type)
- movb #42 ,(r4)+ ; Length of data to follow.
- movb #42 ,(r4)+ ; Sending extended filetype
- mov image ,r0 ; Index into it
- movb 200$(r0),(r4)+ ; Insert it
- clrb @r4 ; .Asciz
- clr r0 ; Success
- return ; Exit
-
- .ASSUME TEXT EQ 0
- .ASSUME BINARY EQ 1
- .ASSUME DECNAT EQ 2
-
- .save ; Save, start a DATA psect
- .psect $pdata ,d
- 200$: .byte 'A&137 ,'I&137 ,'N&137 ,'A&137
- .even
- .restore ; Pop old psect
- .dsabl lsb ; And drop local symbol block
-
-
-
- sn.cdt: movb #'0 ,(r4)+ ; System dependent data following
- movb #41+<6*4>,(r4)+ ; Amount of data to follow
- movb #43 ,(r4)+ ; Date of creation, 64bit format
- CALLS getcdt ,<2(r5)> ; Get address of data
- mov r0 ,r2 ; Successful (ie, not RT11)
- beq 90$ ; No
- mov #4 ,r3 ; Number of words
- 10$: CALLS l$otoa ,<r4,(r2)+> ; Do it
- add #6 ,r4 ; Move over
- sob r3 ,10$ ; Next please
- clrb @r4 ; .ASCIZ
- clr r0 ; Success
- br 100$ ; Exit
- 90$: mov #-1 ,r0 ; Failure
- 100$: return ; Exit
-
-
- sn.typ: movb #42 ,(r4)+ ; attribute type
- movb #41 ,(r4)+ ; /49/ Length of what follows
- movb #'A&137 ,@r4 ; assume ascii
- cmpb image ,#binary ; already decided that it's binary?
- bne 10$ ; no
- movb #'I&137 ,@r4 ; yes, say it's image mode today
- 10$: clrb 1(r4) ; insure .asciz
- clr r0 ; flag success and exit
- return ; bye
-
-
- sn.pr0: call getsys ; /59/ Get system type
- mov r0 ,-(sp) ; /59/ Save it
- calls getpro ,<2(r5)> ; /59/ Get protection for file
- cmpb (sp)+ ,#4 ; /59/ If RSTS, we want to convert
- bne 10$ ; /59/ to files11 format.
- call tof11 ; /59/ Yes, convert
- 10$: movb #54 ,(r4)+ ; /59/ Sending internal protection
- movb #40+6 ,(r4)+ ; /59/ Field is six characters
- calls l$otoa ,<r4,r0> ; /59/ Convert to octal
- add #6 ,r4 ; /59/ Always leave pointing to end
- clrb @r4 ; /59/ And make it .asciz
- clr r0 ; /59/ Success
- return ; /59/ Exit
-
- sn.pr1: mov #-1 ,r0
- return
-
-
- sn.len: calls getsiz ,<2(r5)> ; get the size of the file please
- tst r0 ; did this work ?
- bne 100$ ; no
- inc r1 ; try to accomodate rounding
- asr r1 ; in 1024 blocks, not 512
- bic #100000 ,r1 ; insure no sign bits now
- movb #41 ,(r4)+ ; attribute type (file size)
- movb #45 ,(r4)+ ; length of the number
- deccvt r1,r4,#5 ; convert to ascii
- mov #5 ,r0 ; convert leading spaces to '0'
- 10$: cmpb @r4 ,#40 ; if a space, then make it a '0'
- bne 20$ ; no
- movb #'0 ,@r4 ; yes, stuff a space in
- 20$: inc r4 ; next please
- sob r0 ,10$ ; next please
- clrb @r4 ; insure .asciz
- clr r0 ; to be safe
- 100$: return ; bye
-
-
-
-
- .sbttl dispatch on the type of attribute packet received
- .psect $code
-
- ; R $ A T T R
- ;
- ; input: @r5 the packet address
- ; output: r0 error code, zero for success
-
- r$attr::save <r1,r2,r3,r4,r5> ; just to be safe
- mov @r5 ,r5 ; /49/ Get packet data address
- 10$: movb (r5)+ ,r0 ; /49/ Attribute type code
- beq 90$ ; /49/ Nothing there ???
- movb (r5)+ ,r1 ; /49/ Get length field next
- beq 90$ ; /49/ Nothing there ?
- cmpb r0 ,#'. ; /49/ If this is an OLD kermit-11
- bne 20$ ; /49/ with the invalid packet fmt
- cmpb r1 ,#'D&137 ; /49/ then we will have to make a
- bne 20$ ; /49/ note of it and try to fix it
- mov sp ,oldatt ; /49/ up.
-
- 20$: call 200$ ; /49/ Perhaps fix packets from old K11
- sub #40 ,r1 ; /49/ Convert length to integer
- bmi 90$ ; /49/ Again, nothing was there
- mov #curatr ,r2 ; /49/ Copy current attribute argument
- 40$: movb (r5)+ ,(r2)+ ; /49/ over to a save area now.
- sob r1 ,40$ ; /49/ Next please
- clrb (r2)+ ; /49/ Insure .asciz please
- mov r5 ,-(sp) ; /49/ Make sure the r5 context saved
- scan r0 ,#attrty ; look for the attribute packet type?
- asl r0 ; simple to do
- jsr pc ,@attrds(r0) ; process the attribute packet now
- mov (sp)+ ,r5 ; /49/ Restore the R5 context now.
- tst r0 ; Success
- beq 10$ ; Yes
- br 100$ ; No, exit
- 90$: clr r0 ; Packet format error or end of data
- 100$: unsave <r5,r4,r3,r2,r1> ; bye
- return ; exit
-
-
- 200$: mov r0 ,-(sp) ; /49/ Fix bad attribute data up (?)
- cmpb r0 ,#41 ; /49/ The old (and incorrect) K11's
- beq 220$ ; /49/ did the filesize format ok
- tst oldatt ; /49/ Is this a fubarred old Kermit-11
- beq 220$ ; /49/ No
- dec r5 ; /49/ Yes, we had been forgetting to
- strlen r5 ; /49/ include the length field before
- mov r0 ,r1 ; /49/ the actual attribute data.
- add #40 ,r1 ; /49/ Convert to char format.
- 220$: mov (sp)+ ,r0 ; /49/ So backup one char and reset the
- return ; /49/ Length.
-
- at.$$: clr r0 ; /49/ Ignore unknown attribute types
- return ; /49/ Exit
- ;- calls error ,<#1,#badpak> ; send error back to abort things
- ;- mov #-1 ,r0 ; return 'abort'
- ;- return
-
-
- .sbttl process specific attribute types
-
-
- ; File size in 1024 byte chunks (512 would have been better)
-
- at.len: save <r1,r2> ; save temps please
- clr at$len ; assume zero
- mov #curatr ,r2 ; /49/ Where we saved attributes
- clr r1 ; init the accumulator
- 10$: tstb @r2 ; eol ?
- beq 30$ ; yep
- cmpb @r2 ,#40 ; ignore leading spaces please
- beq 20$ ; yes, a space
- clr -(sp) ; get the next digit please
- movb @r2 ,@sp ; and convert to decimal
- sub #'0 ,@sp ; got it
- mul #12 ,r1 ; shift accum over 10
- add (sp)+ ,r1 ; add in the current digit
- 20$: inc r2 ; next ch please
- br 10$ ; /49/ Next please
- 30$: asl r1 ; convert 1024 blocks to 512 blocks
- mov r1 ,at$len ; save it please
- 100$: unsave <r2,r1> ; pop temps and exit
- clr r0
- return
-
-
- ; Exact size in bytes (type '1')
-
- at.xlen:save <r1,r2,r4,r4,r5> ; /49/ Save temps please
- asl r1 ; /49/ Convert 1024 blocks to 512 blocks
- clr at$len ; /49/ Assume zero
- mov #curatr ,r5 ; /49/ Point to attribute save area
- clr r3 ; /49/ Init the accumulator
- clr r2 ; /49/ Double precision please
- 10$: tstb @r5 ; /49/ Eol ?
- beq 30$ ; /49/ Yep
- cmpb @r5 ,#40 ; /49/ Ignore leading spaces please
- beq 20$ ; /49/ Yes, a space
- mov #12 ,r0 ; /49/ Setup for call to $DMUL
- call $dmul ; /49/ Do it please
- mov r0 ,r2 ; /49/ Restore accumulator values now
- mov r1 ,r3 ; /49/ Ditto....
- clr -(sp) ; /49/ Get the next digit please
- movb @r5 ,@sp ; /49/ And convert to decimal
- sub #'0 ,@sp ; /49/ Got it
- add (sp)+ ,r3 ; /49/ Add in the current digit
- adc r2 ; /49/ Add carry bit in also please
- 20$: inc r5 ; /49/ Next ch please
- br 10$ ; /49/ Next please
- 30$: mov r2 ,r1 ; /49/ Setup for call to $DDIV now
- mov r3 ,r2 ; /49/ Ditto....
- mov #1000 ,r0 ; /49/ Convert to 512 byte blocks now
- call $ddiv ; /49/ Simple
- mov r2 ,at$len ; /49/ Save it please
- tst r0 ; /49/ Was there a remainder ?
- beq 40$ ; /49/ No, exit
- inc at$len ; /49/ Yes, len++
- 40$: call getsys ; /61/ See if RT11, since a UNIX system
- cmpb r0 ,#SY$RT ; /61/ will send the wrong size, ie, RT
- bne 100$ ; /61/ needs CrLf rather than Lf at eol
- mov at$len ,r1 ; /61/ So we will add a small fudge
- ash #-5 ,r1 ; /61/ factor in (len += len/32)
- bic #174000 ,r1 ; /61/ ...
- add r1 ,at$len ; /61/ Tacky, but effective I guess
- 100$: mov at$len ,at$xlen ; /61/ Save
- unsave <r5,r4,r3,r2,r1> ; /49/ Pop temps and exit
- clr r0
- return
-
-
- global <$ddiv ,$dmul>
- global <at.xlen>
-
-
-
- .sbttl more attribute receive options
-
-
- at.typ: cmpb curatr ,#'B&137 ; 'binary' ?
- beq 10$ ; yes
- cmpb curatr ,#'I&137 ; 'image' ?
- bne 100$ ; no
- 10$: mov #binary ,image ; flag for image mode then
- mov #binary ,at$typ ; save it here also
- 100$: clr r0
- return
-
-
- at.cre: clr r0
- return
-
- at.id: clr r0
- return
-
- at.bil: clr r0
- return
-
- at.area:clr r0
- return
-
- at.pas: clr r0
- return
-
- at.bsiz:clr r0
- return
-
- at.acc: clr r0
- return
-
- at.enc: clr r0
- return
-
- at.dis: movb curatr ,at$dis
- clr r0
- return
-
- at.pr0: call ispdp ; /59/ Is this another Kermit-11
- tst r0 ; /59/ sending us protection in
- beq 100$ ; /59/ internal (Files11) format?
- call getsys ; /59/ If it's RSTS, convert from
- mov r0 ,r2 ; /59/ F11 format to RSTS format.
- calls octval ,<#curatr> ; /59/ Convert from octal string.
- cmpb r2 ,#4 ; /59/ Is it RSTS ?
- bne 10$ ; /59/ No, can use as is
- mov r1 ,r0 ; /59/ We are running on a RSTS
- call torsts ; /59/ system, convert it.
- 10$: mov r1 ,at$pr0 ; /59/ Save the protection.
- 100$: clr r0 ; /59/ Success
- return ; /59/ And exit
-
- at.pr1: clr r0
- return
-
- at.sys: movb curatr ,at$sys ; major vendor type
- movb curatr+1,at$sys+1 ; save the system type
- clr r0 ; no errors
- return ; exit
-
- at.for: clr r0
- return
-
-
-
- .sbttl recieve the ifab data for file attributes from another 11
- .enabl lsb
-
- fabsiz = 7*13 ; need at least this many
-
- at.fab: mov #curatr ,r5 ; /49/ Save area for current attr's
- call ispdp ; are we compatible today?
- tst r0 ; no if eq
- beq 100$ ; no, ignore the system dep attr's
- strlen r5 ; packet size ok
- cmp r0 ,#fabsiz ; well....
- bge 40$ ; Ok, must be a IFAB
- mov r5 ,r3 ; /53/ Not an IFAB, perhaps other sys
- cmpb (r3) ,#43 ; /54/ Date info?
- bne 30$ ; /54/ No
- inc r3 ; /54/ Yes, process 4 octal words
- mov sp ,at$cdt ; /54/ Flag we have been here
- mov #4 ,-(sp) ; /54/ Number of words
- mov #at$klu ,r2 ; /54/ Destination
- 10$: clr r1 ; /54/ Accumulator
- mov #6 ,r0 ; /54/ Number of itmes
- 20$: movb (r3)+ ,r4 ; /54/ The next character
- sub #'0 ,r4 ; /54/ Convert to a number
- asl r1 ; /54/ Multiply by 8
- asl r1 ; /54/ ...
- asl r1 ; /54/ ......
- add r4 ,r1 ; /54/ Put in current result
- sob r0 ,20$ ; /54/ Next please
- mov r1 ,(r2)+ ; /54/ Copy the word
- dec (sp) ; /54/ More to do
- bne 10$ ; /54/ Yep
- tst (sp)+ ; /54/ All done
- br 100$ ; /54/ Exit
- ;
- 30$: cmpb (r3)+ ,#42 ; /53/ File type subfunction?
- bne 100$ ; /53/ No, ignore for now
- movb (r3)+ ,r0 ; /53/ Get the file type
- SCAN r0 ,#200$ ; /53/ Look for it
- asl r0 ; /53/ Word addressing
- mov 210$(r0),image ; /53/ Set it
- mov 210$(r0),at$typ ; /53/ Here also.
- br 100$ ; /53/ Exit
-
- 40$: mov #at$fab ,r4 ; copy the packet over now
- mov r5 ,r3 ; and the source please
- mov #-1 ,(r4)+ ; flag that the attributes are for real
- mov #13 ,r2 ; number of words to convert back
- 50$: clrb 6(r3) ; insure .asciz now
- calls octval ,<r3> ; simple
- tst r0 ; successfull?
- bne 90$ ; no, clear flag and exit
- mov r1 ,(r4)+ ; and save the value now
- add #7 ,r3 ; point to the next octal number
- sob r2 ,50$ ; next please
- mov sp ,at$val ; it's ok to use the attributes
- br 100$ ; bye
- 90$: clr at$fab ; error exit (conversion error)
- message <Fab attribute error>,cr; /49/
- 100$: clr r0 ; always flag success and exit
- return
-
- .save
- .psect $pdata ,d
- 200$: .byte 'A ,'I ,'N ,0
- 210$: .word TEXT
- .word TEXT ,BINARY ,DECNAT ,0
- .even
- .restore
- .dsabl lsb
-
-
- .sbttl utility routines
-
- pd$rsx = '8
- pd$ias = '9
- pd$rsts = 'A&137
- pd$rt = 'B&137
- pd$pos = 'C&137
-
- ; I S P D P
- ;
- ; input: nothing
- ; output: r0 <> 0 if the other system is a KERMIT-11 system
- ; errors: none
-
-
- .psect $pdata
-
- pdplst: .byte pd$rsx ,pd$ias ,pd$rsts,pd$rt ,pd$pos ,0
- .even
- .psect $code
-
- ispdp:: clr r0 ; presume failure
- cmpb at$sys ,#'D&137 ; a DEC system ?
- bne 100$ ; no, exit
- scan <at$sys+1>,#pdplst
- 100$: return
-
- clratr::clr at$len
- clr at$xlen
- clr at$typ
- clr at$cre
- clr at$id
- clr at$bil
- clr at$area
- clr at$pas
- clr at$bsiz
- clr at$acc
- clr at$enc
- clr at$dis
- clr at$pr0
- clr at$pr1
- clr at$sys
- clr at$for
- clr at$fab
- clr atrctx
- clr at$klu+0
- clr at$klu+2
- clr at$klu+4
- clr at$klu+6
- clr at$cdt
- return
-
-
- .sbttl finish up the update of rms file attributes to output
-
- ; A T R F I N
- ;
- ; If the file was send in image mode, and we have been sent
- ; valid attributes (basically, the sender's IFAB), then call
- ; PUTATR to place these attributes into our output file's
- ; IFAB so they will get updated.
- ;
- ;
- ; Note: 11-Jul-84 17:12:49 BDN, edit /19/
- ;
- ; Note that for RSTS/E, we have an unusual problem in that if
- ; the sender sent a stream ascii file (most likely a file with
- ; NO attributes) over and the sender said it's binary, then
- ; RMS-11 sends GARBAGE for the VFC header size. When this data
- ; is wriiten into the output file's IFAB, RMS11 finds invalid
- ; data in the IFAB and writes attributes to disk with the last
- ; block field (F$HEOF and F$LEOF) equal to ZERO. Such a file
- ; would thus be unreadable to PIP, RMS and other programs that
- ; look at the file attributes. The fix is one of two things.
- ; One, we can clear the invalid VFC size and fudge the record
- ; size and maximum record size to something usable (like 512),
- ; or we can simply ignore the senders attributes and let the
- ; file stand as a FIXED, NO CC, recordsize 512 file. Rather
- ; than to try to fix the attributes, we will simple ignore the
- ; attributes if the sender said that the file is stream ascii
- ; with a garbage VFC. Since the attributes are only used if
- ; the transfer was in image moed, this will not affect normal
- ; files, only files like DMS-500 files that have no attributes
- ; but must be sent in image mode.
- ; Of course, the sending Kermit-11 can always be given the SET
- ; ATT OFF and SET FIL BIN and the receiving Kermit-11 be given
- ; the SET FIL BIN and the issue will never arise.
- ;
- ; The mods are noted with /19/ after the statement.
-
- atrfin::save <r1,r2,r3> ; just in case please
- tst @r5 ; lun zero ?
- beq 100$ ; yep
- tst at$val ; valid attributes to write ?
- beq 100$ ; no
- tst at$cdt ; Ever set the creation date/time?
- beq 10$ ; No
- calls putcdt ,<@r5,#at$klu> ; Yes, update it
- 10$: cmpb at$typ ,#binary ; did we get this as a binary file?
- bne 100$ ; no
- mov #at$fab ,r1 ; yes
- tst (r1)+ ; valid data present ?
- beq 100$ ; no
- cmp @r1 ,#2000 ; /19/ stream ascii ?
- bne 30$ ; /19/ no
- cmp 16(r1) ,#177400 ; /19/ garbage for the vfc header size?
- beq 90$ ; /19/ yes, forget about the attributes
- 30$: calls putatr ,<@r5,r1> ; /19/ update the ifab for the file
- 90$: clr at$typ ; /19/ no longer valid please
- clr at$fab ; no longer valid please
- clr at$val ; no longer valid please
- 100$: clr at$cdt
- unsave <r3,r2,r1> ; output file and exit
- return
-
-
-
- .sbttl Map RSTS protection codes to Files-11 codes and back
-
-
- ; /59/ 9-OCT-1987 08:11 BDN
- ;
- ; Use the files11 format for transfering protection code
- ; between two kermit-11's, thus it will work even for RSX
- ; to RSTS transfer.
-
- .Save
- .Psect $Pdata ,d
-
-
- dflt.f: .word ^B1100110000000000 ; Default to no world, group
- rsts.p: .word 1*20 ; If 0 set, no owner read
- .word 2*20 ; If 1 set, no owner write
- .word 1*400 ; If 2 set, no group read
- .word 2*400 ; If 3 set, no group write
- .word 1*10000 ; If 4 set, no world read
- .word 2*10000 ; If 5 set, no world write
-
- .Restore
-
- torsts: mov #77 ,r1 ; Start with no access
- clr r2 ; Current bit to set
- mov #6 ,r3 ; Six times please
- clr r4 ; Indexing into bit table
- mov #1 ,r2 ; Start with bit one
- 10$: bit rsts.p(r4),r0 ; Check for F11 bit set
- bne 20$ ; Set, implies access
- bic r2 ,r1 ; So clear it here
- 20$: asl r2 ; Shift it
- tst (r4)+ ; Next bit pattern
- sob r3 ,10$ ; Loopback
- return ; Exit
-
- tof11: mov dflt.f ,r1 ; Default Files-11 bitmask
- clr r2 ; Start with bit zero of RSTS
- mov #6 ,r3 ; Loop six times
- 10$: bit #1 ,r0 ; Check for bit being set in RSTS
- beq 20$ ; code. Not set, leave alone
- bis rsts.p(r2),r1 ; Set, so set the Files-11 prot
- 20$: tst (r2)+ ; Next
- asr r0 ; Get the next bit moved over
- sob r3 ,10$ ; And loop back
- mov r1 ,r0 ; Return in r0
- return ; Exit
-
-
-
- .sbttl 32 bit arithmetic modules from RSX Syslib.olb
-
- $DMUL: MOV R0,-(SP)
- CLR R0
- CLR R1
- 10$: TST (SP)
- BEQ 30$
- ROR (SP)
- BCC 20$
- ADD R3,R1
- ADC R0
- ADD R2,R0
- 20$: ASL R3
- ROL R2
- BR 10$
- 30$: TST (SP)+
- RETURN
-
- $DDIV: MOV R3,-(SP)
- MOV #40,R3
- MOV R0,-(SP)
- CLR R0
- 10$: ASL R2
- ROL R1
- ROL R0
- CMP R0,(SP)
- BCS 20$
- SUB (SP),R0
- INC R2
- 20$: DEC R3
- BGT 10$
- TST (SP)+
- MOV (SP)+,R3
- RETURN
-
-
- .end
-